Wybrane zmienne:
Conditional <- function(idx, obs_idx =123){
dataCopy <- data
obs <- data[obs_idx,]
mean_overall <- predictLearner(lrn,model,dataCopy)[,1] %>% mean()
means <- sapply(idx, FUN = function(i) {
dataCopy[,i] <<- obs[,i]
predictLearner(lrn,model,dataCopy)[,1] %>% mean()
})
means <- c(0,mean_overall,means)
# preparing data to visualtisation
rs <- matrix(c(means,lead(means)),ncol=2)[1:(length(idx)+1),] %>% as.data.frame()
rs <- rs %>% mutate(V3 := as.factor(sign(V2 - V1)),
No := 1:(length(idx)+1),change := V2 - V1)
names(rs) <- c("beg","end","V3","No","change")
numbers2words <- c("intercept",names(data)[idx])
# drawing
Obs.Pred <- rs[nrow(rs),2]
p <- ggplot(data = rs, aes( label1 = beg, label2= end, label3 = change))+
geom_rect(data = rs, aes(xmin = No-0.33,xmax=No+0.33,
ymin = beg, ymax = end, fill = V3, alpha = 0.7)) +
geom_hline(yintercept = Obs.Pred,alpha=0.3,linetype="dotted") +
geom_text(aes(0.5, Obs.Pred*1.015, label = format(Obs.Pred, digits = 3), vjust = -1,alpha = 0.3))+
scale_x_discrete(limits = numbers2words,labels = function( labels ) {
fixedLabels <- c()
for ( l in 1:length( labels ) ) {
fixedLabels <- c( fixedLabels, paste0( ifelse( l %% 2 == 0, '', '\n' ), labels[l] ) )
}
return( fixedLabels )
}) + theme(legend.position="none")
ggplotly(tooltip=c("label1","label2","label3"))
}
Conditional(1:4)
Conditional(4:1)
Conditional(c(2,1,4,3))
Conditional(c(3,4,1,2))